home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 1463.ZIP / DRAW-2D.ARC / ROTATES.PAS < prev    next >
Pascal/Delphi Source File  |  1986-12-03  |  4KB  |  122 lines
  1. PROCEDURE ROTATES;
  2.    VAR
  3.      ANGLE,XREF,YREF:REAL;
  4.      FLAG:BOOLEAN;
  5.      KODE,K:INTEGER;
  6.      MSG:SCRLINE;
  7.    BEGIN
  8.      MOVCUR(24,2);
  9.      WRITE('Select Reference Point & press Left button (Right button for 0,0) >');
  10.      RING(1);
  11.      FLAG := FALSE;
  12.      WHILE NOT(FLAG) DO
  13.        BEGIN
  14.         GETMOUSE(X,Y,PIXX,PIXY,OPTION);
  15.         IF (BUTTON1) OR (BUTTON2) THEN FLAG := TRUE;
  16.         IF (BUTTON1) AND (OPTION <> 0) THEN
  17.            BEGIN
  18.              FLAG := FALSE;
  19.              RING2;
  20.              MOVCUR(24,1);
  21.              WRITE(BLKLINE);
  22.              MOVCUR(24,2);
  23.              WRITE('Move mouse cursor into graphics area!!');
  24.            END;
  25.        END;
  26.      IF BUTTON1 THEN
  27.         BEGIN
  28.           M1 := 2;
  29.           MOUSE(M1,M2,M3,M4);          (* HIDE MOUSE *)
  30.           MARK(PIXX,PIXY,HRCOLOR);
  31.           M1 := 1;                     (* SHOW MOUSE *)
  32.           MOUSE(M1,M2,M3,M4);
  33.           XREF := X;
  34.           YREF := Y;
  35.         END
  36.         ELSE
  37.         BEGIN
  38.           XREF := 0.0;
  39.           YREF := 0.0;
  40.         END;
  41.      MSG := 'Enter Rotation Angle <0.0>: ';
  42.      ANGLE := ASKREAL(24,2,MSG,-360.0,360.0,0.0);
  43.      ANGLE := (ANGLE/360.0) * 2.0 * PI;
  44.      PUSHID(KODE);
  45.      TRANSLAT(-XREF,-YREF,KODE);
  46.      ROTATE(ANGLE,KODE);
  47.      TRANSLAT(XREF,YREF,KODE);
  48.      CASE MNUM OF
  49.      1: BEGIN         (* ENTIRE DRAWING *)
  50.           FOR K := 1 TO OBJPTR-1 DO
  51.            WITH DRAWARY[K] DO
  52.             BEGIN
  53.                CASE OBJTYP OF
  54.             0: BEGIN      END;                      (*  DELETED OBJECT *)
  55.             1: MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (*  POINT  *)
  56.             2: BEGIN                                (*  LINE   *)
  57.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  58.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  59.                END;
  60.             3: BEGIN                                (*  BOX  *)
  61.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  62.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  63.                  MODVEC(X3,Y3,STKMAT[STKPTR-1]);
  64.                END;
  65.             4: BEGIN
  66.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (* CIRCLE *)
  67.                END;
  68.               END; (* CASE *)
  69.             END; (*WITH*)
  70.         END;
  71.      2: BEGIN         (* AREA *)
  72.           FOR K := 1 TO OBJPTR-1 DO
  73.            WITH DRAWARY[K] DO
  74.             BEGIN
  75.                IF OBJSEL = 1 THEN
  76.                CASE OBJTYP OF
  77.             0: BEGIN      END;                      (*  DELETED OBJECT *)
  78.             1: MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (*  POINT  *)
  79.             2: BEGIN                                (*  LINE   *)
  80.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  81.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  82.                END;
  83.             3: BEGIN                                (*  BOX  *)
  84.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  85.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  86.                  MODVEC(X3,Y3,STKMAT[STKPTR-1]);
  87.                END;
  88.             4: BEGIN
  89.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (* CIRCLE *)
  90.                END;
  91.               END; (* CASE *)
  92.             END; (*WITH*)
  93.         END;
  94.      3: BEGIN         (* SINGLE OBJECT *)
  95.            WITH DRAWARY[SELNUM] DO
  96.             BEGIN
  97.                CASE OBJTYP OF
  98.             0: BEGIN      END;                      (*  DELETED OBJECT *)
  99.             1: MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (*  POINT  *)
  100.             2: BEGIN                                (*  LINE   *)
  101.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  102.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  103.                END;
  104.             3: BEGIN                                (*  BOX  *)
  105.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);
  106.                  MODVEC(X2,Y2,STKMAT[STKPTR-1]);
  107.                  MODVEC(X3,Y3,STKMAT[STKPTR-1]);
  108.                END;
  109.             4: BEGIN
  110.                  MODVEC(X1,Y1,STKMAT[STKPTR-1]);      (* CIRCLE *)
  111.                END;
  112.               END; (* CASE *)
  113.             END; (*WITH*)
  114.         END;
  115.        END; (* CASE *)
  116.      POPMAT(KODE);
  117.      M1 := 2;
  118.      MOUSE(M1,M2,M3,M4);          (* HIDE MOUSE *)
  119.      REDRAW;
  120.      M1 := 1;                     (* SHOW MOUSE *)
  121.      MOUSE(M1,M2,M3,M4);
  122.   END; (*PROC*)